***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
store CTOD("  /  /    ") to patdob,AEADAT,mdsdat,DATFIL,ENTDAT,HLST,HLEND                                                                                                                                                                                 
STORE SPACE(1) TO  MINIT,PATSEX,BLOODR,compin,CODTYP,CODCRE                                                                                                                                                                                               
BLOODG=SPACE(2)                                                                                                                                                                                                                                           
store space(4) to cocod,CODDAT                                                                                                                                                                                                                            
store space(6) to relcod,kodepat                                                                                                                                                                                                                          
JOBTELEX=SPACE(12)                                                                                                                                                                                                                                        
store space(14) to HOMCITY,homtel,loctel,LOCCITY,HOMCOUNT,jobfax                                                                                                                                                                                          
pronam=SPACE(15)                                                                                                                                                                                                                                          
STORE SPACE(16) TO PNAME,PFNAME,PATNAT,JOBCITY,JOBCOUNT,JOBTEL1,JOBTEL2,JOBTEL3,mdsnbr,famrelper                                                                                                                                                          
store space(20) to JOBPERMGR,JOBFINMGR,relper                                                                                                                                                                                                             
store space(32) to LOCADD1,JOBPOSIT,conam                                                                                                                                                                                                                 
STORE SPACE(40) TO HOMADD,LOCADD2,jobadd2,darf                                                                                                                                                                                                            
STORE SPACE(35) TO INSTYP                                                                                                                                                                                                                                 
STORE SPACE(45) TO INSNAM                                                                                                                                                                                                                                 
STORE CTOD('  /  /    ') TO INSVAL                                                                                                                                                                                                                        
JOBADD1=SPACE(48)                                                                                                                                                                                                                                         
store .f. to AEAM,PER,DOC,FAM,MDS,relper,reldoc,HL,truepat,AEAHL                                                                                                                                                                                          
DO WHILE LASTKEY()<>27 .and. .NOT. truepat                                                                                                                                                                                                                
   SET COLOR TO BG+/B                                                                                                                                                                                                                                     
   @ 9,1 CLEA TO 23,78                                                                                                                                                                                                                                    
   DO BOX3 WITH 9,3,"RETRIEVAL BY :","PATIENT'S CODE","PATIENT'S NAME","SWIPE CARD",'GR+','RB','GR+','R',PIL2,.F.,.T.                                                                                                                                              
   do case                                                                                                                                                                                                                                                
   case PIL2=1                                                                                                                                                                                                                                            
        DO BOXE WITH 16,3,"PATIENT'S CODE : ",'KODEPAT','GR+','R','W+','N',6,.T.,.T.                                                                                                                                                                      
        DO BYCODE

**   case PIL2=3                                                                                                                                                                                                                                            
**        DO PRECOM                                                                                                                                                                                                                                         
**        IF LASTKEY()=27                                                                                                                                                                                                                                   
**           RETURN                                                                                                                                                                                                                                         
**        ENDIF                                                                                                                                                                                                                                             
**        SELE 1                                                                                                                                                                                                                                            
**        set exclu off                                                                                                                                                                                                                                     
**        USE &DR&F1 INDE &DR&F1                                                                                                                                                                                                                            
**        SEEK KODEPAT                                                                                                                                                                                                                                      
**        IF .NOT. EOF()                                                                                                                                                                                                                                    
**           do patr2b                                                                                                                                                                                                                                      
**        ENDIF

    CASE PIL2=3 
        DO PATR40

        IF LASTKEY()=27
           RETURN
        ENDIF

**        @ 20,5 SAY "CALLING ..... BYCODE"
**        DO BOXE WITH 16,3,"PATIENT'S CODE#2 : ",'KODEPAT','GR+','R','W+','N',6,.T.,.T.                                                                                                                                                                      

        KODEPAT = FIELD_PATFIL

        IF  TRUEPAT = .T.  
          DO BYCODE
        ENDIF

   case pil2=2                                                                                                                                                                                                                                            
        DO PATR7                                                                                                                                                                                                                                          
   other                                                                                                                                                                                                                                                  
        loop                                                                                                                                                                                                                                              
   ENDcase                                                                                                                                                                                                                                                
   if PRPAT .OR. pil4=2 .or. lastkey()=27                                                                                                                                                                                                                 
      return                                                                                                                                                                                                                                              
   endif                                                                                                                                                                                                                                                  
ENDDO                                                                                                                                                                                                                                                     
RETURN                                                                                                                                                                                                                                                    


PROC BYCODE

   SELE 1
   SET EXCLU OFF                                                                                                                                                                                                                                     
   USE &DR&F1 INDE &DR&F1                                                                                                                                                                                                                            
   SELE 2                                                                                                                                                                                                                                            
   SET EXCLU OFF                                                                                                                                                                                                                                     
   USE &DR&F2 INDEX &DR&F2                                                                                                                                                                                                                           
   SELE 1                                                                                                                                                                                                                                            
   set exclu off                                                                                                                                                                                                                                     
   USE &DR&F1 INDE &DR&F1                                                                                                                                                                                                                            
   SEEK KODEPAT                                                                                                                                                                                                                                      
   IF EOF()                                                                                                                                                                                                                                          
      set colo to bg+/b,w+/n                                                                                                                                                                                                                         
      @ 10, 1 CLEA TO 23,78                                                                                                                                                                                                                          
      DO BOXT WITH 13,1,"THIS CODE NUMBER DOES NOT MATCH A REGISTERED PATIENT'S CODE",'GR+','R',.F.,.T.                                                                                                                                              
      WAIT ' '
      RETURN
   ELSE                                                                                                                                                                                                                                               
      SELE 1                                                                                                                                                                                                                                         
      REC=RECNO()                                                                                                                                                                                                                                    
      do patr2b                                                                                                                                                                                                                                      
   ENDIF                                                                                                                                                                                                                                             

RETURN 
